home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / dviware / crudetype / version3 / hpgf.ch < prev    next >
Text File  |  1991-11-28  |  26KB  |  833 lines

  1. % hpgf.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
  2. % HPGF.CH  Provisional change file for the HP Laserjet...
  3. % NOTE the system change file must normally be inserted above this point.
  4. % SEE   HPGF.DOC   for users document--which must be rewritten for any new
  5. % system.
  6. % BUGFIX 19-dec-1990 Bug spoilt Landscape mode.
  7. %
  8.  
  9. @x  Module 41; Lines 822 -- 839
  10. When this module starts, the \.{DVI} file should be positioned at or before a
  11. BOP.
  12.  
  13. @<For each page...@>=
  14.   read_BOP;
  15.   if (counter[0] >= first_page) then start := true ;
  16.   if start and (count_pages > 0 )
  17.   then begin
  18.     @<Maybe a formfeed@>
  19.     decr(count_pages);
  20.     if not quiet then display('[', counter[0]:1 ); {Progress report}
  21.     Read_one_page ;
  22.     @<Sort the page@>
  23.     Send_page ;
  24.     if not quiet then display( ']' );
  25.   end
  26.   else if ( count_pages > 0) then Skip_page
  27.   else time_to_stop := true;
  28. @y
  29. When this module starts, the \.{DVI} file should be positioned at or before a
  30. BOP.
  31.  
  32. This is where the printer change file proper begins. This change file goes
  33. with \.{Crudetype} version 2. First, it should be explained that the HP is not
  34. at all a "crude" printer, and the mechanisms of \.{Crudetype} are not really
  35. suitable for it. It is really stretching the program a very long way from its
  36. intended purpose. In particular, some changes have to be spliced into the
  37. middle of the program, instead of going at the end as printer changes ought
  38. to. It seems that the only reasonable way to drive a HP is by downloading all
  39. the required characters. As stated in \.{Crudetype}, the problems of
  40. downloading are extremely difficult and I have not solved them in any
  41. satisfactory manner. The code given below manages downloading in the simplest
  42. and crudest way possible.
  43.  
  44. First, I have added flags to print either even or odd pages only. In
  45. principle, this will allow double sided printing. Also, we do not sort the
  46. page as the HP can jump about.
  47.  
  48. @<For each page...@>=
  49.   read_BOP;
  50.   if (counter[0] >= first_page) then start := true ;
  51.   if start and (count_pages > 0 ) and (
  52.     ( odd( counter[0]) = odds) or (( not evens) and ( not odds)) )
  53.   then begin
  54.     decr(count_pages);
  55.     if not quiet then display('[', counter[0]:1 ); {Progress report}
  56.     Read_one_page ;
  57.       @<Dont sort the page but |reset| it @>
  58.     Send_page ;
  59.     @<Maybe a formfeed@>
  60.     if not quiet then display( ']' );
  61.   end
  62.   else if ( count_pages > 0) then Skip_page
  63.   else time_to_stop := true;
  64. @z
  65.  
  66. % Next, the HP has its own rule-setting commands.
  67. @x  Module 57; Lines 1126 -- 1136
  68.   procedure set_rule;
  69.   var D_p,D_q: integer;
  70.   begin
  71.     D_p:=get_integer(dvi) (-4);
  72.     D_q:=get_integer(dvi)(-4);
  73.     if (D_p<=0)or(D_q<=0) then
  74.       {an invisible rule! Dont ask me why \TeX\ wants to do this}
  75.     else if (D_p*v_conv <= post_height/2)
  76.     then do_rail(D_p, D_q)
  77.     else do_post(D_p, D_q);
  78.   end;
  79. @y
  80.   procedure set_rule;
  81.   var D_p,D_q: integer;
  82.   rule_h, rule_v, rule_ht, rule_wid: integer ; {all in pixels}
  83.   begin
  84.     D_p:=get_integer(dvi) (-4);
  85.     D_q:=get_integer(dvi)(-4);
  86.     if (D_p<=0)or(D_q<=0) then
  87.     {an invisible rule! Dont ask me why \TeX\ wants to do this}
  88.     else begin @<Find the pixel sizes and reference point@>
  89.       @<Send it to the printer@>
  90.     end;
  91.   end;
  92. @z
  93.  
  94. % Dont shunt on a fine printer
  95. @x  Module 154; Lines 2678 -- 2679
  96.   if H_shunt > (Set_h - 3)
  97.   then H_shunt :=  (Set_h - 3) ;
  98. @y
  99.   do_nothing ;
  100. @z
  101.  
  102. @x  Module 174; Lines 2958 -- 2959
  103. @d out_of_sequence ==
  104.   ( ( Old_v > Set_v) or ( ( Old_v = Set_v) and ( Old_h > Set_h)))
  105. @y
  106. Since we do not sort, we will not separate the characters into runs.
  107.  
  108. @d out_of_sequence == false
  109. @z
  110.  
  111. % Again, shunting is only appropriate for line printers.
  112. @x  Module 186; Lines 3157 -- 3157
  113.       PR_h_next := hpos - H_shunt ;
  114. @y
  115.       PR_h_next := hpos ;
  116. @z
  117.  
  118. @x  Module 207; Lines 3467 -- 3484
  119. @ So here are their default values. We believe they are all appropriate for
  120. lineprinters on VMS machines. Note that the program makes no attempt to check
  121. these values for consistency.
  122.  
  123. @<Set init...@>=
  124.   device_ID := 'Lineprinter '; {Pad to 12 chars}
  125.   list := false ;
  126.   fortran := false ;
  127.   b_feed_absolute := false ;
  128.   b_feed_by_string := false ;
  129.   feed_absolute := false ;
  130.   b_feed_scream := true ;
  131.   b_space_absolute := false ;
  132.   b_space_by_string := false ;
  133.   space_absolute := false ;
  134.   abs_is_incr := false ;
  135.   wl_does_cr := false ;
  136.   want_split := true ;
  137. @y
  138. @ The first lot of data describes the HP's overall style of carriage
  139. control. Many of them are completely irrelevant to the HP, but still needed in
  140. order for the program to compile.
  141.  
  142. @<Set init...@>=
  143.   device_ID := 'Laserjet +  ';
  144.   list := false ;
  145.   fortran := false ;
  146.   b_feed_absolute := true ;
  147.   b_feed_by_string := false ;
  148.   feed_absolute := true ;
  149.   b_feed_scream := true ;
  150.   b_space_absolute := true ;
  151.   b_space_by_string :=false ;
  152.   space_absolute := true ;
  153.   abs_is_incr := false ;
  154.   wl_does_cr := false ;
  155.   want_split := true ;
  156.   is_header := false ; {each page needs a header}
  157. @z
  158.  
  159. @x  Module 208; Lines 3518 -- 3527
  160. @ The general run of \TeX\ characters are narrower than line-printer chars. So
  161. we spread them out to make them fit.
  162.  
  163. @<Set init...@>=
  164.   l_margin := 1.0 ; {Normal left margin, in inches}
  165.   top_margin := 1.0 ; {Top ditto}
  166.   h_fudge := 7.227 {number of points per |h_step|}
  167.   / 5.25 ; {A typical design width}
  168.   v_fudge := 2.0 ;
  169.   { Force double-spacing, in hope that suffixes will come out right}
  170. @y
  171. @ The general run of \TeX\ characters are narrower than line-printer chars.
  172. But the HP prints them at their proper widths.
  173.  
  174. @<Set init...@>=
  175.   l_margin := 1.0 ; {Normal left margin, in inches}
  176.   top_margin := 1.0 ; {Top ditto}
  177.   h_fudge := 1.0 ;
  178.   v_fudge := 1.0 ;
  179. @z
  180.  
  181. @x  Module 213; Lines 3584 -- 3594
  182. @ This batch is concerned with distances and resolutions.
  183.  
  184. @<Const...@>=
  185.   h_resolution = 10 ;         {|h_steps| per inch}
  186.   v_resolution = 6 ;          {|v_steps| per inch}
  187.   fixed_width = true ;        {printers characters are fixed width}
  188.   char_width = 1 ;
  189.   {all printer characters are this width, in units of |h_step|. Normally,
  190.     |space_dist| will be equal to this, but some printers are not normal!}
  191.   gap_width = 1 ; {Intended minimum space between words}
  192.   char_ht = 1 ;
  193. @y
  194. @ This batch is concerned with distances and resolutions.
  195.  
  196. @<Const...@>=
  197.   h_resolution = 300 ;         {|h_steps| per inch}
  198.   v_resolution = 300 ;         {|v_steps| per inch}
  199.   fixed_width = false ;
  200.   char_width = 30 ;    {default char. sizes in |h_steps| -- a guess}
  201.   gap_width = 5 ; {Intended minimum space between words}
  202.   char_ht = 42 ;
  203. @z
  204.  
  205. @x  Module 216; Lines 3616 -- 3620
  206.   max_font = 1 ;
  207.   only_one_font = true ;
  208.   can_dl_font = false ;
  209.   min_dl_font = 0 ;
  210.   max_dl_font = 0 ; {printers down-loadable fonts}
  211. @y
  212.   max_font = 40 ;
  213.   only_one_font = false ;
  214.   can_dl_font = true ;
  215.   min_dl_font = 8 ;
  216.   max_dl_font =  40 ; {printers down-loadable fonts. The HP allows up to 32}
  217. @z
  218.  
  219. @x  Module 234; Lines 4022 -- 4024
  220. @<Assign char...@>=
  221.   @<Define Lineprinter codes@>
  222.   @<Set rule characters@>
  223. @y
  224.   @<Assign char...@>= do_nothing
  225. @z
  226.  
  227. @x  Module 235; Lines 4028 -- 4028
  228. *** Attach printer change file here ***
  229. @y
  230.  
  231. @ The remaining changes can all go at the end of the program. Before getting
  232. onto the hardest task (namely, downloading) lets clear up the loose ends that
  233. were left lying about in the body of the program. First, there are a number of
  234. extra command options:
  235.  
  236. @<If the |key|...@>=
  237.   else if ( key = "O") then odds := true  {Print odd-numbered pages only}
  238.   else if ( key = "E") then evens := true {Even ditto}
  239.   else if ( key = "L") then begin
  240.     land := true ;  {Print Landscape}
  241.     start_stuff.data[ 8] := '1' ; {bugfix, 19-dec-1990, previously 6}
  242.   end
  243.  
  244. @ @<Glob...@>=
  245.   land, odds, evens: boolean ;
  246.  
  247. @ @<Set init...@>=
  248.   land := false ;
  249.   odds := false ;
  250.   evens := false ;
  251.  
  252. @ Where will the printed file go to?
  253.  
  254. @<Set init...@>=
  255.   be_string(  '.HPL') ; print_ex := buffer ;
  256.  
  257. @ @<Dont sort the page but |reset| it @>=
  258.   L_reset( run) ;
  259.   Add_run ;
  260.   L_reset( mid) ;
  261.   cur_pge_ptr := son( next( mid) ) ;
  262.  
  263. @ Now lets dispose of rule-setting. \TeX\ puts the reference point of a rule
  264. at bottom left, the HP at top left. Sizes must be rounded up.
  265.  
  266. @<Find the pixel sizes and reference point@>=
  267.   rule_ht := round(v_conv*D_p + 0.5) ;
  268.   rule_wid := round(h_conv*D_q + 0.5) ;
  269.   D_dis := D_q ;
  270.   IM_dis := rule_wid ;
  271.   round_IM_h ( 0);
  272.   rule_h := IM_h ;
  273.   rule_v := IM_v - rule_ht ;
  274.  
  275. @ @<Send it to the printer@>=
  276.   set_v_abs(rule_v) ;
  277.   set_h_abs(rule_h) ;
  278.   print(chr(27), '*c', rule_ht:1, 'B') ;
  279.   print(chr(27), '*c', rule_wid:1, 'A') ;
  280.   print(chr(27), '*c0P') ;
  281.   print_ln;
  282.  
  283. @ Consider command strings.
  284.  
  285. @<Set init...@>=
  286.   be_string ( '^[E^[&l0O' ) ; start_stuff := buffer ;
  287.     {Reset everything to default state}
  288.   be_string ( '^[(&DX' ) ; font_command := buffer ;
  289.   be_string ( '^[*p&DY' ) ; v_abs_com := buffer ;
  290.   be_string ( '^[*p&DX ' ) ; h_abs_com := buffer ;
  291.   stop_stuff := start_stuff ;
  292.   page_top := blank ;
  293.   pause_after := blank ;
  294.  
  295. @ On the HP, we must explicitly start a new page at a set position. Also since
  296. rules get set before any characters, we must then reset the position.
  297.  
  298. @<Set up an empty page...@>=
  299.   set_v_abs(0) ;
  300.   set_h_abs(0) ;
  301.  
  302. @ @<Pause reset@>=
  303.   set_v_abs(0) ;
  304.   set_h_abs(0) ;
  305.  
  306. @* Downloading, 1: reading the font file.
  307.  
  308. The simplest and crudest way this could possibly be done is: read the raster
  309. file and load the entire font, as soon as the |font_def| command is read from
  310. the \.{DVI} file. On VAX/VMS, this turned out to be unbearably slow. So it is
  311. here changed as follows: When a |font_def| command is read, we read the whole
  312. raster file into an array. Then download each character before trying to print
  313. it. This `lazy downloading' makes the program run much faster, at the price of
  314. a large use of memory.
  315.  @^\.{TUG}boat@>
  316.  
  317. @<Download a whole font@>=
  318.   begin
  319.     @<Prepare to read the |raster_file|@>
  320.     repeat
  321.       @<Get \.{GF} command |GF_com|, and do it@>
  322.     until GF_com = 248;
  323.     close_binary( raster_file) ;
  324.     @<Establish the new font in memory@>
  325.   end
  326.  
  327. @ First we have to determine the file name.
  328.  
  329. @<Prepare to read...@>=
  330.   raster_mag := round(300 * font_mag *  magnification ) ;
  331.   if not hunt_for_size( font_name, raster_mag)
  332.   then font_error('cannot load this font') ;
  333.     @.Error: cannot load@>
  334.  
  335. @ @<Medium...@>=
  336.   function open_font(
  337.     name: var_string; mag: integer; ask: boolean ): boolean;
  338.   begin
  339.     splice( raster_name, raster_def, mag) ;
  340.     open_font := open_and_ask(
  341.       raster_file, raster_indx, name, raster_name, ask) ;
  342.   end;
  343.  
  344. @ Frequently the {\.DVI} file calls for a font at a magnification that is
  345. almost but not quite one of the standard sizes. So we try a few steps up or
  346. down before giving up. |range| is the maximum percentage that we allow the
  347. magnification to vary.
  348.  
  349. @<Forw...@>=
  350.   function hunt_for_size (
  351.     name: var_string; mag: integer): boolean; forward ;
  352.  
  353. @ @<Medium...@>= function hunt_for_size ;
  354.   label exit ;
  355.   const range = 5 ;
  356.   var try_mag, n , max : integer; hh: boolean;
  357.   begin
  358.     max := round( raster_mag* range / 100);
  359.     n := 0 ;
  360.     while ( n <= max) do begin
  361.       try_mag := mag + n ;
  362.       hh := open_font( name, try_mag, false) ;
  363.       if hh then return
  364.       else if ( n>0) then n:= -n
  365.       else n := 1 - n ;
  366.     end;
  367.     hh := open_font( name, mag, true) ;
  368.     exit: hunt_for_size := hh;
  369.   end;
  370.  
  371. @ Then read the file; a horrible mess.
  372.  
  373. @<Get \.{GF} command...@>=
  374.   GF_com := get_byte( raster) ;
  375.   if GF_com <= 63 then paint( GF_com)
  376.   else if (  GF_com >= 74) and (  GF_com <= 238) then
  377.   new_row(  GF_com - 74 )
  378.   else
  379.  
  380. @ Then we have the usual messy |case| statement:
  381.  
  382. @d three_cases(#)==
  383.   #,#+1,#+2 : begin GF_par := get_integer( raster)( GF_com - # + 1 );
  384.     four_case_end
  385.  
  386. @<Get \.{GF} command...@>=
  387.   case GF_com of
  388.     three_cases( 64)( paint( GF_par));
  389.     67, 68: boc;
  390.     69: eoc;
  391.     70: miss_row( 0);
  392.     three_cases( 71)( miss_row( GF_par));
  393.     three_cases( 239)( skip( raster)( GF_par));
  394.     242: skip( raster)( get_integer( raster)( -4)) ;
  395.     243: skip( raster)( 4);
  396.     244:;
  397.     247: preamble;
  398.     248: postamble ;
  399.     245,246,249,250,251,252,253,254,255:
  400.       warn( 'illegal GF command, will try to continue');
  401.   end;
  402.     @.illegal GF command@>
  403.  
  404. @ Now there follow lots of procedures to deal with the commands.
  405.  
  406. @<Lowest...@>=
  407.   procedure preamble;
  408.   var p: byte;
  409.   begin
  410.     p:=get_byte( raster);
  411.     p:=get_byte( raster);
  412.     skip( raster)( p) ;   {the introductory comment}
  413.     with Font_box do begin
  414.       L := pixel_R ;
  415.       R := pixel_L ;
  416.       T := pixel_B ;
  417.       B := pixel_T ;
  418.     end;
  419.   end;
  420.  
  421. @#
  422.   procedure postamble;
  423.   var GF_check: integer ;
  424.   begin
  425.     skip( raster)( 8);
  426.     GF_check := get_integer( raster)( -4) ;
  427.     if (D_check<>0)and(GF_check<>0)and(D_check<>GF_check) then
  428.     begin warn('check sums do not agree!');
  429.         @.error: check sums...@>
  430.       display_ln('DVI check was: ', D_check, ' GF check was: ', GF_check);
  431.       display('   ');
  432.     end;
  433.   end;
  434.  
  435. @#
  436.   procedure boc;
  437.   var q : byte; mm, nn: i_word;
  438.   begin
  439.     if GF_com = 67 then
  440.     begin GF_char := get_integer( raster)( 4) mod 256 ;
  441.       skip( raster) ( 4);
  442.       Boc_box.L:=get_integer( raster)( -4);
  443.       Boc_box.R:=get_integer( raster)( -4);
  444.       Boc_box.B:=get_integer( raster)( -4);
  445.       Boc_box.T:=get_integer( raster)( -4);
  446.     end
  447.     else begin GF_char:=get_byte( raster);
  448.       q:=get_byte( raster); Boc_box.R:=get_byte( raster);
  449.       Boc_box.L:=Boc_box.R-q;
  450.       q:=get_byte( raster); Boc_box.T:=get_byte( raster);
  451.       Boc_box.B:=Boc_box.T-q;
  452.     end;
  453.     @<Clear the image@>
  454.   end;
  455.  
  456. @ Now lets assign names to variables. In order to try to clear up the muddle
  457. of boundaries for character cells, I introduce a concept of a ``box'', not the
  458. same as a \TeX\ box. The fields represent the boundaries that must contain all
  459. the black pixels of any character.
  460.  
  461. @<Const...@>=
  462.   pixel_L = -300; pixel_R = 700; pixel_B = -300; pixel_T = 700;
  463.  
  464. @ @<Types...@>=
  465.   @!x_coord=pixel_L..pixel_R;
  466.   @!y_coord=pixel_B..pixel_T;
  467.   box = packed record
  468.     L,R: x_coord;
  469.     T,B: y_coord;
  470.   end;
  471.   dir_entry = packed record
  472.     point: integer;
  473.     h_offset, v_offset, wid, ht : i_word;
  474.   end;
  475.  
  476. @ @<Glob...@>=
  477.   Boc_box,            {Limits of char. cell declared in |BOC| command}
  478.   char_box,            {actual boundaries of char. cell}
  479.   Font_box: box;       {The font cell.  This is the smallest cell that
  480.       contains the reference point and any char. cell in the font}
  481.   GF_com, GF_par, GF_char : byte;
  482.   glyphs: packed array[1..max_glyph] of byte ;
  483.   glyph_ptr: integer;
  484.   raster_mag: integer;
  485.   directory : array[D_font_ptr, D_char_ptr ] of dir_entry ;
  486.   C_width : integer;
  487.  
  488. @ @<Set init...@>=
  489.   glyph_ptr := 1 ;
  490.   for in_i := 0 to max_D_fonts do
  491.   for in_j := 0 to max_D_char do
  492.   directory[ in_i, in_j].point := sentry ;
  493.     {Mark everything as unprintable}
  494.  
  495. @ The definition of \.{GF} files refers to two registers, $(G_m,G_n)$, which
  496. hold row and column numbers.  We also need to remember |paint_switch|, which
  497. is either |black| or |white|.
  498.  
  499. @<Glob...@>=
  500.   @!pixels: packed array [y_coord,x_coord] of pixel;
  501.   @!G_m: x_coord;
  502.   @!G_n: y_coord; {current state values}
  503.   @!paint_switch: pixel;
  504.  
  505. @ We'll need a big array of pixels to hold the character image.  Each pixel
  506. should be represented as a single bit in order to save space. Different
  507. systems may prefer the following definitions, while others may do better using
  508. the |boolean| type and constants.
  509.  @^system dependencies@>
  510.  
  511. @d white==false
  512. @d black==true
  513. @d swop == paint_switch:=not paint_switch
  514. {could also be |if paint_switch=black then paint_switch:=white
  515. else paint_switch:=black|}
  516.  
  517. @<Types...@>=
  518. @!pixel=boolean ;
  519.  {could also be |white..black|}
  520.  
  521. @ Maybe there's a faster way to do this on your system.  Note that the only
  522. part of the |image_array| that we clear is the part that the current character
  523. may use.  Thus, the rest of this program may not look outside the area
  524. delimited by |Boc_box| and expect to see anything but junk.
  525. @^system dependencies@>
  526.  
  527. @<Clear the image@>=
  528.   begin
  529.     for nn := Boc_box.B to Boc_box.T do
  530.     for mm := Boc_box.L to Boc_box.R do
  531.     pixels[nn,mm] := white;
  532.     G_n := Boc_box.T ;
  533.     G_m := Boc_box.L ;
  534.     char_box.L := pixel_R ;
  535.     char_box.R := pixel_L ;
  536.     char_box.B := pixel_T ;
  537.     char_box.T := pixel_B ;
  538.     directory[ nf, GF_char].point := 0 ;
  539.       {Indicates a blank character}
  540.   end
  541.  
  542. @ @<Lowest...@>=
  543.   procedure paint( p: integer);
  544.   var m, k: integer;
  545.   begin
  546.     if G_m+p> pixel_R then
  547.     warn('character extends too far to the right')
  548.       @.character extends...@>
  549.     else if paint_switch = white then
  550.     else begin
  551.       m := G_m + p -1 ;
  552.       if char_box.T < G_n then char_box.T := G_n ;
  553.       if char_box.B > G_n then char_box.B := G_n ;
  554.       if char_box.L > G_m then char_box.L := G_m ;
  555.       for k:= G_m to m do
  556.       pixels[G_n, k] := black ;
  557.       if char_box.R < m then char_box.R := m ;
  558.     end;
  559.     swop;
  560.     G_m := G_m +p ;
  561.   end;
  562.  
  563. @#
  564. procedure new_row( p:integer);
  565.   begin
  566.     decr(G_n);
  567.     G_m:=Boc_box.L + p;
  568.     paint_switch:=black;
  569.   end;
  570.  
  571. @# procedure miss_row( p: integer);
  572.   begin
  573.     G_n:=G_n - p ;
  574.     G_m:= Boc_box.L;
  575.     paint_switch:=white;
  576.   end;
  577.  
  578. @* Downloading, 2: Transfer characters into memory.
  579.  
  580. After we have read the character, we must transfer it into memory. First,
  581. stretch the Font box to include the current characters box.
  582.  
  583. @<Lowest...@>=
  584.   procedure eoc;
  585.   var x, y : integer;
  586.   cur_byt: byte ;
  587.   q: i_word ;
  588.   begin
  589.     if char_box.R >= char_box.L {If not, the character is unprintable}
  590.     then begin
  591.       if char_box.L < Font_box.L then  Font_box.L := char_box.L ;
  592.       if char_box.B < Font_box.B then  Font_box.B := char_box.B ;
  593.       if char_box.R > Font_box.R then  Font_box.R := char_box.R ;
  594.       if char_box.T > Font_box.T then  Font_box.T := char_box.T ;
  595.       @<Transfer the dimensions of the character@>
  596.       @<Transfer the |pixels| into |glyphs|@>
  597.     end;
  598.   end;
  599.  
  600. @ In landscape mode, the character must be rotated. The |directory| will
  601. contain the dimensions to be downloaded; these do depend on orientation.
  602. |char_box| describes the logical character which does not depend on
  603. orientation.
  604.  
  605. @<Transfer the dimensions...@>=
  606.   with directory[nf, GF_char] do begin
  607.     point := glyph_ptr;
  608.     if land then begin
  609.       h_offset := - char_box.T ;
  610.       v_offset := char_box.R ;
  611.       ht := char_box.R - char_box.L +1 ;
  612.       wid := char_box.T - char_box.B +1 ;
  613.     end else begin
  614.       h_offset := char_box.L ;
  615.         {\TeX\ and the HP measure this in opposite directions}
  616.       v_offset := char_box.T ;
  617.       wid := char_box.R - char_box.L +1 ;
  618.       ht := char_box.T - char_box.B +1 ;
  619.     end;
  620.   end;
  621.  
  622. @ Likewise the |glyphs| array will contain the pixels to be downloaded; these
  623. also depend on orientation. Looking at the logical character, |x| is the
  624. horizontal coordinate and |y| the vertical. In portrait mode the pixels must
  625. be sent starting at the top left corner and going left to right along the top
  626. row. In Landscape mode you must start at the top right corner and go down the
  627. right hand column. Each row or column must be padded to |8n| bits.
  628.  
  629. @<Transfer the |pixels|...@>=
  630.   if land then begin
  631.     for x := char_box.R downto char_box.L do begin
  632.       cur_byt := 0 ;
  633.       q := 0 ;
  634.       for y := char_box.T downto char_box.B do begin
  635.         if pixels[ y, x] then cur_byt := cur_byt + powers[q] ;
  636.         if q < 7 then incr( q)
  637.         else begin
  638.           glyphs[glyph_ptr] := cur_byt ; incr( glyph_ptr) ; cur_byt := 0;
  639.           q := 0 ;
  640.         end;
  641.       end;
  642.       if q > 0 then
  643.       begin
  644.         glyphs[glyph_ptr] := cur_byt ; incr( glyph_ptr) ; cur_byt := 0;
  645.       end;
  646.     end;
  647.   end else
  648.  
  649. @ @<Transfer the |pixels|...@>=
  650.   begin
  651.     for y := char_box.T downto char_box.B do begin
  652.       cur_byt := 0 ;
  653.       q := 0 ;
  654.       for x := char_box.L to char_box.R do begin
  655.         if pixels[ y, x] then cur_byt := cur_byt + powers[q] ;
  656.         if q < 7 then incr( q)
  657.         else begin
  658.           glyphs[glyph_ptr] := cur_byt ; incr( glyph_ptr) ; cur_byt := 0;
  659.           q := 0 ;
  660.         end;
  661.       end;
  662.       if q > 0 then
  663.       begin
  664.         glyphs[glyph_ptr] := cur_byt ; incr( glyph_ptr) ; cur_byt := 0;
  665.       end;
  666.     end;
  667.   end ;
  668.  
  669. @ @<Set init...@>=
  670.   powers[0] := 128 ;
  671.   for in_i := 1 to 7 do powers[in_i] :=  powers[in_i-1] div 2 ;
  672.  
  673. @ @<Glob...@>= powers: array[0..7] of byte ;
  674.  
  675. @ @<Const...@>= max_glyph = 1000000 ;
  676.  
  677. @ @<Clean...@>=
  678.   display_ln
  679.     ('Used ', glyph_ptr:1, ' bytes of font memory out of ', max_glyph:1);
  680.  
  681. @ Finally, does the printer have enough room for the font? The HP allows 32
  682. fonts per job and 395 KB memory. I have not checked the restriction of only 16
  683. fonts per page.
  684.  
  685. @<Establish...@>=
  686.   incr(PR_dl_font ) ;
  687.   if PR_dl_font > max_dl_font then
  688.   font_error('tried to load too many fonts') ;
  689.     @.Error: tried to load@>
  690.  
  691. @ @<Set init...@>=
  692.   PR_dl_font := min_dl_font ;
  693.   PR_mem_used := 0 ;
  694.   PR_max_mem := 395000;
  695.   be_string( '^[*c&DD' ) ;  font_start := buffer ;
  696.  
  697. @ @<Glob...@>= PR_dl_font, PR_max_mem, PR_mem_used: integer ;
  698.   font_start: var_string ;
  699.  
  700. @ If the error tests succeed, then we come here. Before we can load any
  701. characters, we have to send a command to the printer to declare the new font.
  702. This section assembles the necessary information. |dir_start[ nf]| should be
  703. pointing to the start of the font directory. The main task is that the printer
  704. must be given the size of a character cell; this must be large enough to
  705. contain all the characters. First we specify the font ID. This is a number by
  706. which the printer will refer to the font after loading it.
  707.  
  708. @<Establish...@>=
  709.   print_command( font_start, PR_dl_font, '^') ;
  710.   print(chr(27), ')s26W' );
  711.     {A create font command}
  712.   prw(26);
  713.   prw(1) ;  { 8 bit chars}
  714.   prw(0) ;
  715.   with Font_box do begin
  716.     if L > 0 then L := 0 ;
  717.     if B > 0 then B := 0 ;
  718.     if R < 0 then R := 0 ;
  719.     if T < 0 then T := 0 ; {Stretch the Font box to include the ref. point}
  720.     prw( T) ;
  721.     prw( R - L + 1) ; {width}
  722.     prw( T - B + 1) ; {height}
  723.   end;
  724.   if land then prw( 257) else prw(1) ;  {proportional spaced}
  725.   prw(277) ;
  726.   for font_i := 1 to 5 do prw(0) ;
  727.     {The HP needs these parameters, but they serve no purpose known to me}
  728.  
  729. @ Finally, we must establish the map from \TeX\ characters to printers
  730. characters in the new font.
  731.  
  732. @<Establish...@>=
  733.   incr(top_code) ;   {get a new coding scheme}
  734.   scheme[ nf] := top_code ;
  735.   alphabet(0, 33, top_code, PR_dl_font, 190);
  736.   alphabet(33, 95, top_code, PR_dl_font, 33);
  737.   for tex_chr := 0 to max_D_char do
  738.   codes[ top_code, tex_chr].breadth := down_loaded ;
  739.  
  740. @ @<Glob...@>= top_code: integer ;
  741.  
  742. @ @<|font_def| vars@>= tex_chr, font_i: integer;
  743.  
  744. @ @<Set init...@>= top_code := 1 ;
  745.  
  746. @* Downloading, 3: Lazy downloading.
  747.  
  748. The idea is to load only those characters in each font that actually will be
  749. printed. It is obviously essential to ensure that each character gets loaded
  750. before being printed, and only once. This is done in the procedure
  751. |set_character|.  The \TeX\ character is number |c_num| in font |D_font|,
  752. but the printer character is addressed by |cod|.
  753.  
  754. The first job is to update the directory info. for the character, and assemble
  755. its size parameters.
  756.  
  757. @<Enter a download...@>=
  758.   with directory [ D_font, c_num] do begin
  759.     if point < 0 then begin warn(
  760.         'tried to print a non-existent character, number: ' , c_num:1) ;
  761.       codes[ cur_scheme, c_num].breadth := bad_char ;
  762.     end else begin
  763.       C_length := ht * (( wid + 7) div 8) ; {length of data}
  764.       C_width := D_width[ D_font, c_num] ;
  765.       C_delta := round(C_width * h_conv) ;
  766.       codes[ cur_scheme, c_num].breadth := C_delta ;
  767.       cod.breadth := C_delta ;
  768.       PR_mem_used := PR_mem_used + C_length + 64 ;   {approximate}
  769.       if PR_mem_used  > PR_max_mem then
  770.       warn('overflowed printer memory, will try to proceed regardless') ;
  771.         @.Error: overflowed printer memory@>
  772.         @.Error: tried to print...@>
  773.  
  774. @ @<Clean...@>=
  775.   display_ln
  776.   ('Used ', PR_mem_used:1, ' bytes of printers memory out of ',
  777.     PR_max_mem:1) ;
  778.  
  779. @ @<Glob...@>=
  780.   C_length, C_delta : integer;
  781.   char_start, char_head: var_string ;
  782.  
  783. @ @<Set init...@>=
  784.   be_string( '^[*c&DE' ) ;  char_start := buffer ;
  785.   be_string( '^[(s&DW' ) ;  char_head := buffer ;
  786.  
  787. @ Now we must not let the character get downloaded twice, so we put the
  788. correct value into its |breadth|; we must also update the current |cod|.
  789.  
  790. @ Now we send the character header. First, tell the printer which character
  791. will be downloaded. \TeX\ fonts usually have 128 characters and HP fonts have
  792. either 96 or 192. The permitted values for HP characters are 33..127 and
  793. 160..255 according to the manual but appendix B says 160 and some others are
  794. undefined. So we map \TeX\ characters 0..32 onto 190..222 .
  795.  
  796. @<Enter a download...@>=
  797.     { N.B. still |with directory [ D_font, c_num]| }
  798.   print_command( font_start, cod.IM_font, '^') ;
  799.     {Specify printers font identifier}
  800.   print_command( char_start, cod.IM_char, '^') ;
  801.   print_command( char_head, (C_length + 16), '^') ;
  802.     {and the character}
  803.   prw(1024);
  804.   prw(14*256 + 1);
  805.   if land then prw( 256 ) else prw(0);
  806.   prw(h_offset) ;
  807.   prw(v_offset);
  808.   prw(wid) ;
  809.   prw(ht) ;
  810.   prw(4 * C_delta) ;
  811.  
  812. @ And at long last we can send the pixels!!
  813.  
  814. @<Enter a download...@>=
  815.   for d_i := point to point+C_length-1 do
  816.   print(chr(glyphs[ d_i] )) ;
  817.   print_ln ;
  818. end; end;
  819.  
  820. @ Nearly all the HP's arguments come as signed 16-bit words, to be printed in
  821. two-complement notation. This procedure prints them.
  822.  
  823. @<Low...@>=
  824.   procedure prw( n: i_word);
  825.   var nn: integer ;
  826.   begin
  827.     if (n>= 0) then nn := n
  828.     else nn := n + 65536 ;
  829.     print( zchr(nn div 256));
  830.     print( zchr(nn mod 256));
  831.   end ;
  832. @z
  833.